home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 20 / Cream of the Crop 20 (Terry Blount) (1996).iso / os2 / ftree10f.zip / ImGedcom.ftx < prev    next >
Text File  |  1996-05-25  |  15KB  |  503 lines
  1. /*
  2.    Family Tree Rexx Script FTX
  3.  
  4.    Copyright (C) 1996 by <Nils Meier>
  5.  
  6.    Please send comments to / Kommentar bitte an
  7.         meier2@athene.informatik.uni-bonn.de
  8.  
  9.    <This script imports a family tree from a GEDCOM file
  10.     / Dieses Skript importiert einen Stammbaum aus einer GEDCOM Datei.>
  11. */
  12.  
  13.  
  14. /* ----------------------- Params  /  Parameter ------------------- */
  15. datasex   = 'MW'
  16. datamonth = 'JAN FEB MAR APR MAY JUN JUL AUG SEP OCT NOV DEC'
  17. crlf      = '0d0a'x
  18.  
  19. IF getLanguage()='Deutsch' THEN DO
  20.    header      = 'Importieren von GEDCOM-Daten :'
  21.    select      = 'GEDCOM-Import-Datei angeben:'
  22.    fileerror   = 'Fehler: Einladen von '
  23.    nogedcom    = 'Fehler: Keine GEDCOM-Datei '
  24.    foundheader = 'HEADER gefunden !'
  25.    done        = 'Fertig !'
  26.    sourceis    = 'Quellsystem ist '
  27.    sourcedate  = 'Hergestellt am '
  28.    unexpected  = 'Unerwartetes Ende der Datei !'
  29.    ignoring    = 'Beim Einlesen wurden ignoriert: '
  30.    oopsDate    = 'Undeutliches Datum  : '
  31.    oopsSex     = 'Undeutliches Geschl : '
  32.    oopsID      = 'Undeutliche  ID     : '
  33.    importstart = 'Starte jetzt Berechnung des Stammbaumes !'crlf'Die letzte Person aus der GEDCOM-Datei wird Ursprung :'
  34. END
  35. ELSE DO
  36.    header      = 'Importing from GEDCOM :'
  37.    select      = 'Select GEDCOM file for import:'
  38.    fileerror   = 'Error: Reading from '
  39.    nogedcom    = 'Error: No GEDCOM file '
  40.    foundheader = 'Found HEADER !'
  41.    done        = 'Done !'
  42.    sourceis    = 'Source system is '
  43.    sourcedate  = 'Produced at '
  44.    unexpected  = 'Unexpected end of file !'
  45.    ignoring    = 'Had to ignore during load:'
  46.    oopsDate    = 'Ambiguous Date : '
  47.    oopsSex     = 'Ambiguous Sex  : '
  48.    oopsID      = 'Ambiguous ID   : '
  49.    importstart = 'Starting Calculation of family tree !'crlf'Last person in GEDCOM-file becomes Origin :'
  50. END
  51.  
  52. /* ----------------- Display Header / Kopf der Ausgabe ------------- */
  53. SAY(header||DATE())
  54. SAY('')
  55.  
  56.  
  57. /* ------------------- Open file  /  Datei oeffnen  ---------------- */ 
  58. file=getFileName(select,'*.GED')
  59. IF (file='') THEN DO
  60.    SAY(done)
  61.    RETURN
  62.    END
  63.  
  64. rc=LINEIN(file,1,0)
  65. rc=LINES(file)
  66. IF (rc=0) THEN DO
  67.    SAY(fileerror||file)
  68.    RETURN
  69.    END
  70.  
  71. /* -------------- Header of GEDCOM  /  Kopf von GEDCOM -------------- */
  72.  
  73. input=LINEIN(file)
  74. PARSE VAR input lev tag
  75. IF (lev<>0)|(tag<>'HEAD') THEN DO 
  76.    SAY(nogedcom||file||' (Expected 0 HEAD)')
  77.    RETURN
  78.    END
  79. SAY(foundheader)
  80. rc=inputFromGedcom()
  81. DO FOREVER
  82.    PARSE VAR input lev tag value
  83.    SELECT
  84.      WHEN rc<>'' THEN LEAVE
  85.      WHEN lev='0' THEN LEAVE
  86.      WHEN tag='SOUR' THEN SAY(sourceis||'"'||value||'"')
  87.      WHEN tag='DATE' THEN SAY(sourcedate||'"'||value||'"')
  88.      OTHERWISE NOP
  89.    END
  90.    rc=waitLev(1)
  91. END
  92. SAY('')
  93. IF rc<>'' THEN DO
  94.    SAY(rc)
  95.    RETURN
  96. END
  97.  
  98.  
  99. /* ---- Read Persons&Families / Personen und Familien einlesen --- */
  100.  
  101. PIgnored=''
  102. FIgnored=''
  103. SIgnored=''
  104.  
  105. DO FOREVER
  106.    PARSE VAR input lev tag1 tag2 rest
  107.    /* Check for INDI & FAM  /  Suchen nach INDI & FAM */
  108.    SELECT
  109.      WHEN rc<>'' THEN LEAVE
  110.      WHEN tag2='INDI' THEN rc=readPerson()
  111.      WHEN tag2='FAM'  THEN rc=readFamily()
  112.      WHEN tag1='TRLR' THEN LEAVE
  113.      OTHERWISE DO
  114.         IF WORDPOS(tag2,SIgnored)=0 THEN SIgnored=SIgnored tag2
  115.         rc=waitLev(0)
  116.      END
  117.    END
  118.    /* Next Datapacket /  Naechster Datensatz */
  119. END
  120. SAY('')
  121.  
  122. /* ------------------ End of Import  /  Ende des Imports --------------- */
  123.  
  124. IF rc='' THEN DO
  125.  
  126.    SAY(ignoring '(Structs)')
  127.    SAY(SIgnored)
  128.    SAY('')
  129.  
  130.    SAY(ignoring '(in INDI)')
  131.    SAY(PIgnored)
  132.    SAY('')
  133.  
  134.    SAY(ignoring '(in FAM)')
  135.    SAY(FIgnored)
  136.    SAY('')
  137.  
  138.    SAY(importstart)
  139.    SAY(importDone())
  140.  
  141.  
  142.    SAY(done)
  143.    END
  144. ELSE
  145.    SAY(rc)
  146.  
  147.  
  148. RETURN
  149.  
  150.  
  151.  
  152.  
  153. /* =============== Read Functions / Lesefunktionen =============== */
  154.  
  155.  
  156. /* ------------- Read Person  /  Person einlesen ------------------ */
  157.  
  158. readPerson:
  159.    id=WORD(input,2)  /* Needed for Ambiguous */
  160.  
  161.    PID        =calcID(id)
  162.    PAddr      =''
  163.    PNote      =''
  164.  
  165.    IF PID=0 THEN RETURN(waitLev(0))
  166.    rc=importPerson()
  167.    ok=setPID(PID)
  168.  
  169.    rc=inputFromGedcom()   /* input = lev tag value */
  170.    DO FOREVER
  171.      lev  =   WORD(input,1)
  172.      tag  =   WORD(input,2)
  173.      value=SUBWORD(input,3)
  174.  
  175.      /* ---- Take data   / Daten übernehmen --- */
  176.      SELECT
  177.        /*-------------------------------------------*/
  178.        WHEN rc<>''  THEN RETURN(rc||'('||id||')')
  179.        WHEN lev=0 THEN LEAVE
  180.        /*-------------------------------------------*/
  181.        WHEN tag='NAME' THEN DO
  182.          PARSE VAR value fname1 '/' name '/' fname2
  183.          ok=setName(STRIP(name))
  184.          ok=setFirstName(STRIP(fname1||fname2))
  185.          rc=waitLev(1)
  186.        END
  187.        /*-------------------------------------------*/
  188.        WHEN tag='SEX' THEN DO
  189.          ok=setSex(calcSex(value))
  190.          rc=waitLev(1)
  191.        END
  192.        /*-------------------------------------------*/
  193.        WHEN tag='BIRT' THEN DO
  194.          rc=inputFromGedcom()  /* input = lev tag value */
  195.          DO FOREVER
  196.             lev=WORD(input,1)
  197.             tag=WORD(input,2)
  198.             SELECT
  199.               WHEN rc<>''     THEN LEAVE
  200.               WHEN lev<=1     THEN LEAVE
  201.               WHEN tag='DATE' THEN ok=setBirthDate(calcDate(SUBWORD(input,3)))
  202.               WHEN tag='PLAC' THEN ok=setBirthPlace(SUBWORD(input,3))
  203.               OTHERWISE NOP
  204.             END
  205.             rc=waitLev(2)
  206.          END
  207.        END
  208.        /*-------------------------------------------*/
  209.        WHEN tag='DEAT' THEN DO
  210.          rc=inputFromGedcom()  /* input = lev tag value */
  211.          DO FOREVER
  212.             lev=WORD(input,1)
  213.             tag=WORD(input,2)
  214.             SELECT
  215.               WHEN rc<>''     THEN LEAVE
  216.               WHEN lev<=1     THEN LEAVE
  217.               WHEN tag='DATE' THEN ok=setDeathDate(calcDate(SUBWORD(input,3)))
  218.               WHEN tag='PLAC' THEN ok=setDeathPlace(SUBWORD(input,3))
  219.               OTHERWISE NOP
  220.             END
  221.             rc=waitLev(2)
  222.          END
  223.        END
  224.        /*-------------------------------------------*/
  225.        WHEN tag='PHOT' THEN DO
  226.          ok=setPicture(value)
  227.          rc=waitLev(1)
  228.        END
  229.        /*-------------------------------------------*/
  230.        WHEN tag='OCCU' THEN DO
  231.          ok=setOccupation(value)
  232.          rc=waitLev(1)
  233.        END
  234.        /*-------------------------------------------*/
  235.        WHEN tag='ADDR' THEN DO
  236.          addr=value
  237.          rc=inputFromGedcom()  /* input = lev tag value */
  238.          DO FOREVER
  239.             lev=WORD(input,1)
  240.             tag=WORD(input,2)
  241.             SELECT
  242.               WHEN rc<>''     THEN LEAVE
  243.               WHEN lev<=1   THEN LEAVE
  244.               WHEN tag='CONT' THEN addr=addr||','||SUBWORD(input,3)
  245.               WHEN tag='PHON' THEN addr=addr||','||SUBWORD(input,3)
  246.               OTHERWISE NOP
  247.             END
  248.             rc=waitLev(2)
  249.          END
  250.          IF PAddr<>'' THEN PAddr=PAddr||','
  251.          PAddr=PAddr||addr
  252.        END
  253.        /*-------------------------------------------*/
  254.        WHEN tag='PHON' THEN DO
  255.          IF PAddr<>'' THEN PAddr=PAddr||','
  256.          PAddr=PAddr||value
  257.          rc=waitLev(1)
  258.        END
  259.        /*-------------------------------------------*/
  260.        WHEN tag='NOTE' THEN DO
  261.          PNote=value
  262.          rc=inputFromGedcom()  /* input = lev tag value */
  263.          DO FOREVER
  264.             lev=WORD(input,1)
  265.             tag=WORD(input,2)
  266.             SELECT
  267.               WHEN rc<>''     THEN LEAVE
  268.               WHEN lev<=1     THEN LEAVE
  269.               WHEN tag='CONT' THEN PNote=PNote||crlf||SUBWORD(input,3)
  270.               OTHERWISE NOP
  271.             END
  272.             rc=waitLev(2)
  273.          END
  274.        END
  275.        /*-------------------------------------------*/
  276. /*
  277.        WHEN tag='FAMC' THEN DO
  278.          PChildren=PChildren value
  279.          rc=waitLev(1)
  280.        END
  281.        /*-------------------------------------------*/
  282.        WHEN tag='FAMS' THEN DO
  283.          PSpouses=PSpouses value
  284.          rc=waitLev(1)
  285.        END
  286. */
  287.        /*----------------------------------------